The X-Philes (2nd Revision)/The X-Philes Number 1 (1995).iso/xphiles/hp48_1/pubdom.tar/pubdom/e_vogel/vftobj

Text File | 1990-05-20 | 3KB | 42 lines

%%HP: T(3)A(D)F(.);                        @ VFTOBJ: verify that two arguments
                                           @ are both unit objects containing
                                           @ only pure temperature units.
                                           @ Object examination approach.
\<<                                        @ obj2 obj1 ->
  IF                                       @ obj2 obj1 obj2 obj1 ->
    DUP2                                   @ obj2 obj1 obj2 obj1 ->
    TYPE 13 SAME                           @ obj1 unit object?
                                           @ obj2 obj1 obj2 T/F ->
    SWAP TYPE 13 SAME                      @ obj2 unit object?
                                           @ obj2 obj1 T/F T/F ->
    AND                                    @ Both unit objects?
                                           @ obj2 obj1 T/F ->
  THEN                                     @ Both unit objects
                                           @ obj2 obj1 ->
    DUP2                                   @ obj2 obj1 obj2 obj1 ->
    UBASE                                  @ Make into base units
                                           @ obj2 obj1 obj2 ubobj1 ->
    OBJ\->                                 @ obj2 obj1 obj2 nbobj1 ubobj1 ->
    SWAP DROP                              @ obj2 obj1 obj2 ubobj1 ->
    SWAP                                   @ obj2 obj1 ubobj1 obj2 ->
    UBASE                                  @ Make into base units
                                           @ obj2 obj1 ubobj1 ubobj2 ->
    OBJ\->                                 @ obj2 obj1 ubobj1 nbobj2 ubobj2 ->
    SWAP DROP                              @ obj2 obj1 ubobj1 ubobj2 ->
    OVER                                   @ obj2 obj1 ubobj1 ubobj2 ubobj1 ->
    ==                                     @ Same dimensions?
                                           @ obj2 obj1 ubobj1 T/F ->
    SWAP 1_K ==                            @ Pure temperature?
                                           @ obj2 obj1 T/F T/F ->
    AND                                    @ Both pure temperatures?
                                           @ obj2 obj1 T/F ->
    IF                                     @ Both pure temperatures
    THEN
    ELSE                                   @ Both not pure temperatures
      #B02h DOERR                          @ Error: Inconsistent Units
    END                                    @ obj2 obj1 ->
  ELSE                                     @ Both not unit objects
    #202h DOERR                            @ Error: Bad Argument Type
  END
\>>